home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1997 April: Mac OS SDK / Dev.CD Apr 97 SDK1.toast / Development Kits (Disc 1) / MacTCP / MacTCP Developer Tools / HyperCard MacTCP Toolkit 1.0 / Source Code ƒ / TCPRecvUpTo.p < prev    next >
Encoding:
Text File  |  1994-11-21  |  5.6 KB  |  195 lines  |  [TEXT/MPS ]

  1. (*
  2.     TCPRecvUpTo(connectionID,termination character, waitTime,oldString) -- Return a string from the
  3.         TCP connection; return everything available, up to the termination character (if any). Pass an empty
  4.         termination character to receive everything available. WaitTime is the amount of time to wait
  5.         for the input, in ticks (60ths of a second). oldString is what was read the last call (presumably
  6.         terminated due to a time-out).
  7.  
  8.     To compile and link this file using Macintosh Programmer's Workshop,
  9.  
  10.         pascal -w TCPRecvUpTo.p
  11.         link -m ENTRYPOINT -o HyperCommands -rt XFCN=7864 -sn Main=TCPRecvUpTo ∂
  12.             TCPRecvUpTo.p.o "{Libraries}HyperXLib.o" "{MPW}"Libraries:interface.o
  13.  
  14.     © Copyright 1988 by Apple Computer, Inc.
  15.  
  16.     Initial coding 12/88 by Harry R. Chesley.
  17. *)
  18.  
  19. {$R-}
  20.  
  21. {$S TCPRecvUpTo }     { Segment name must be the same as the command name. }
  22.  
  23. unit DummyUnit;
  24.  
  25. interface
  26.  
  27. uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;
  28.  
  29. procedure EntryPoint(paramPtr: XCmdPtr);
  30.     
  31. implementation
  32.  
  33. procedure TCPRecvUpTo(paramPtr: XCmdPtr); forward;
  34.  
  35. procedure EntryPoint(paramPtr: XCmdPtr);
  36.  
  37.     begin
  38.         TCPRecvUpTo(paramPtr);
  39.     end;
  40.  
  41. procedure TCPRecvUpTo(paramPtr: XCmdPtr);
  42.  
  43.     var str: Str255;
  44.         waitForChars: longInt;        { Ticks to wait until for characters (compated to TickCount). }
  45.         lookForTerm: boolean;        { True if we're looking for a terminator character. }
  46.         termChar: SignedByte;        { The terminator character we're looking for. }
  47.         resultHand: Handle;            { A handle to the result string. }
  48.         resultSize: longInt;            { The size of the result string (minus the zero termination tacked on last). }
  49.         inChar: SignedByte;
  50.         p: Ptr;
  51.  
  52.     procedure Fail(errMsg: Str255); { set theResult and quit }
  53.         begin
  54.             paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
  55.             exit(TCPRecvUpTo);
  56.         end;
  57.  
  58.     {$I TCPUtil.inc}
  59.  
  60.     procedure disposAndFail(err: str255);
  61.         { Fail routine used after the result handle has been allocated. }
  62.  
  63.         begin
  64.             DisposHandle(resultHand);
  65.             Fail(err);
  66.         end;
  67.  
  68.     procedure putByte(b: SignedByte);
  69.         { Put the byte b after the output handle, increasing the handle's size in the process. }
  70.  
  71.         var p: Ptr;
  72.  
  73.         begin
  74.             resultSize := resultSize+1;
  75.             SetHandleSize(resultHand,resultSize);
  76.             if MemError <> noErr then disposAndFail('§§§ SetHandleSize failed §§§');
  77.             p := Ptr(ord4(resultHand^)+resultSize-1);
  78.             p^ := b;
  79.         end;
  80.  
  81.     function nextByte: SignedByte;
  82.         { Return the next byte in the buffer, reading more in if necessary. }
  83.     
  84.         var waitUntil: longInt;
  85.             readIn: longInt;
  86.     
  87.         begin
  88.             with Connection^ do
  89.                 begin
  90.                     { Check if we need to read in more bytes. }
  91.                     if incomingSize = 0 then
  92.                         begin
  93.                             { If yes, then keep on trying to read until we get at least one, or the time-out happens. }
  94.                             waitUntil := TickCount + waitForChars;
  95.                             while true do
  96.                                 begin
  97.                                     { Get the status. }
  98.                                     ZeroIOParms;
  99.                                     SyncControlBlock.csCode := TCPcsStatus;
  100.                                     if PBControl(@SyncControlBlock,false) <> noErr then
  101.                                         disposAndFail('§§§ TCP status failed §§§');
  102.                                     readIn := ControlWordAtOffset(60);
  103.                                     { If there's something there to read, do so. }
  104.                                     if readIn > 0 then
  105.                                         begin
  106.                                             { Don't read any more than will fit in the buffer. }
  107.                                             if readIn > INCOMINGBUFSIZE then readIn := INCOMINGBUFSIZE;
  108.                                             { Issue the read. }
  109.                                             ZeroIOParms;
  110.                                             SyncControlBlock.csCode := TCPcsRcv;
  111.                                             PutControlLongAtOffset(ord4(@inBuf),36);
  112.                                             PutControlWordAtOffset(readIn,40);
  113.                                             if PBControl(@SyncControlBlock,false) <> noErr then
  114.                                                 disposAndFail('§§§ TCP read failed §§§');
  115.                                             incomingSize := readIn;
  116.                                             incomingPtr := @inBuf;
  117.                                             leave;
  118.                                         end
  119.                                     { If not, do another round or get out, depending on the timeout condition. }
  120.                                     else if TickCount > waitUntil then
  121.                                         begin
  122.                                             putByte(0);
  123.                                             paramPtr^.returnValue := resultHand;
  124.                                             exit(TCPRecvUpTo);
  125.                                         end;
  126.                                 end;
  127.                         end;
  128.                     { Get the byte to return. }
  129.                     nextByte := incomingPtr^;
  130.                     incomingPtr := Ptr(ord4(incomingPtr)+1);
  131.                     incomingSize := incomingSize-1;
  132.                 end;
  133.         end;
  134.  
  135.     begin
  136.         if paramPtr^.paramCount <> 4 then Fail('§§§ parameter count is not 4 §§§');
  137.  
  138.         SetUpConnectionID;
  139.  
  140.         GetStrParm(2,str);                                        { First parameter is termination character. }
  141.         if length(str) = 0 then lookForTerm := false
  142.         else
  143.             begin
  144.                 lookForTerm := true;
  145.                 termChar := ord(str[1]);
  146.             end;
  147.         waitForChars := GetLongParm(3);                    { Second parameter is whether to wait. }
  148.         resultHand := paramPtr^.params[4];                { Third parameter is the old string. }
  149.  
  150.         { If there's anything in the "previous" string, copy it. }
  151.         if resultHand <> NIL then
  152.             begin
  153.                 p := resultHand^;
  154.                 resultSize := 0;
  155.                 while p^ <> 0 do
  156.                     begin
  157.                         resultSize := resultSize + 1;
  158.                         p := Ptr(ord4(p)+1);
  159.                     end;
  160.                 if resultSize < 0 then Fail('§§§ Input string size too small §§§');
  161.                 if HandToHand(resultHand) <> noErr then Fail('§§§ HandToHand failed §§§');
  162.                 SetHandleSize(resultHand,resultSize);
  163.             end
  164.         { On the other hand, if the previous string is empty, make a new, empty one. }
  165.         else
  166.             begin
  167.                 resultHand := NewHandle(0);
  168.                 resultSize := 0;
  169.             end;
  170.  
  171.         { Cycle until the timeout happens or we see the termintor character. }
  172.         while true do
  173.             begin
  174.                 { Get the next character. }
  175.                 inChar := nextByte;
  176.                 { Ignore the character if it's a zero. }
  177.                 if inChar <> 0 then
  178.                     begin
  179.                         { Put it in the result. }
  180.                         putByte(inChar);
  181.                         { Check for the end. }
  182.                         if lookForTerm then
  183.                             if inChar = termChar then leave;
  184.                     end;
  185.             end;
  186.  
  187.         { Add in the zero termination for the string. }
  188.         putByte(0);
  189.  
  190.         { Return the handle. }
  191.         paramPtr^.returnValue := resultHand;
  192.     end;
  193.  
  194. end.
  195.